home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / biblio / bibtex / utils / lookbibtex / lookbibtex.dist < prev    next >
Text File  |  1993-03-18  |  6KB  |  221 lines
  1. #!/usr/dist/bin/perl
  2.  
  3. #
  4. # lookbibtex 1.22
  5. #    Look in to a bib file.
  6. # Comments to <johnh@cs.ucla.edu>.
  7. #
  8. # Copyright (C) 1990 by John Heidemann
  9. # This is distributed under the GNU Public Licence, Version 1 (Feb 89).
  10. # See the Perl documentation for a copy of that license.
  11. #
  12. #  4-Oct-90 it is hacked together.
  13. # 19-Nov-90 Now it remembers "'s and join such lines.
  14. #    It also removes nasty characters like {} from the search string.
  15. # 20-Nov-90 Umlaut accents handled correctly.
  16. # 28-Nov-90 A simple heuristic to handle multi-line fields with {}'s is added.
  17. #       In addition, we compress all whitespace to single spaces in the
  18. #    searched version.  lookbibtex 1.1
  19. #  4-Jan-91 Converted the -k option to -f, since field makes more sense than
  20. #     keyword.  lookbibtex 1.11
  21. # 17-Jan-91 Added -s option to pass through strings, instead of ignoring them.
  22. # 31-May-91 ficus directory moved
  23. # 26-Aug-91 Documentation fixed.  The environment variable LOOKBIBTEXFILE
  24. #       will set the default bibtex file to use.
  25. #       lookbibtex 1.12 released, posted to anonymous ftp at cs.ucla.edu.
  26. # 28-Aug-91 Usage string fixed at suggestion of
  27. #       Henk P. Penning <henkp@cs.ruu.nl>.
  28. #  5-Sep-91 Argument processing re-done (now matches grep, as it always
  29. #       should have).  Changes from Tim Wilson <tdw@cl.cam.ac.uk> to
  30. #       handle multiple bib files and select default bib files from BIBINPUTS.
  31. #       lookbibtex 1.2
  32. # 29-Jan-92 Bug reported by Dana Jacobsen <jacobsd@frisby.cs.orst.edu>:
  33. #    "badkeys" are handled in a case sensitive manner.  Fixed.
  34. #       lookbibtex 1.21
  35. # 25-Feb-92 Sigh.  Bug fixes always make more bugs.  Bug in last fix, fixed.
  36. #       lookbibtex 1.22
  37. #
  38. # This program relies on the convention that the closing } of a 
  39. # bib entry is the only } in the first non-whitespace column,
  40. # and that the opening @ is also there.
  41. #
  42.  
  43.  
  44.  
  45. $* = 1;   # make searches on vars with imbedded newlines work
  46. $prog = substr($0,rindex($0,'/')+1);
  47.  
  48.  
  49. $badkeys = "string";    # keys to ignore (list in lowercase only)
  50.  
  51.  
  52. #
  53. # do argument processing
  54. #
  55.  
  56. @files = ();           # files to search
  57. $passthroughbad = 0;   # -s flag
  58. undef ($pattern);      # will be set below
  59. undef ($keyword);      # may be set below
  60.  
  61. sub remember_file {
  62.     local ($file) = @_;
  63.     local ($dev, $ino) = stat ($file);
  64.     local ($key) = "$dev,$ino";
  65.     if (!defined($files{$key})) {
  66.         $files{$key} = $file;
  67.         push (@files, $file);
  68.         
  69.     };
  70. #    warn ("file $file ($key) remembered.\n");
  71. };
  72.  
  73. while ($#ARGV >= 0) {
  74.     if ($ARGV[0] eq "-s") {
  75.         $passthroughbad = 1;
  76.     } elsif ($ARGV[0] eq "-f" && $#ARGV >= 1) {
  77.         $keyword = $ARGV[1];
  78.         shift (@ARGV);
  79.     } elsif (defined($pattern)) {
  80.         &remember_file ($ARGV[0]);
  81.     } else {
  82.         $pattern = $ARGV[0];
  83.     };
  84.     shift (@ARGV);
  85. };
  86.  
  87. if (!defined($pattern)) {
  88.     die ("Usage: $prog [-s] [-f field] regexp [bibfile.bib ...]\n" .
  89.         "   Fields restricts the regexp search to that bibtex " .
  90.             "field entry (author, etc.)\n" .
  91.         "   Default bibfile is $defaultfile, - indicates stdin.\n" .
  92.         "   Regexp is a Perl regexp.\n");
  93. };
  94.  
  95. #
  96. # handle the keyword by modifying the pattern
  97. #
  98. if (defined($keyword)) {
  99.     $pattern = "^\\s*${keyword}\\s*=.*${pattern}";
  100. #    print "pattern is $pattern\n";
  101. };
  102.  
  103. #
  104. # Handle choosing default bib files:
  105. # Select anything from BIBINPUTS.
  106. #
  107. if ($#files == -1) {
  108.     $searchpath = ($ENV{'BIBINPUTS'} || ".");
  109.     foreach $dir (split(/:/, $searchpath)) {
  110.                 opendir(DIR, $dir) || do {
  111.                         warn "$prog: Can't open directory `$dir', skipping\n";
  112.                         next;
  113.                 };
  114.                 foreach $file (grep(/\.bib$/, readdir(DIR))) {
  115.             &remember_file ($dir . "/" . $file);
  116.                 };
  117.                 closedir(DIR);
  118.     };
  119. };
  120.  
  121. die ("$prog: no files on command line or in BIBINPUTS\n") if ($#files == -1);
  122.  
  123. $manyfiles = ($#files > 0);   # remember if to show filenames or not
  124.  
  125.  
  126.  
  127. #
  128. # Certain keys we really want to ignore because
  129. # they're not bib entries.  They're listed here.
  130. #
  131. @badkeys = split(/,/, $badkeys);
  132. foreach $i (@badkeys) {
  133.     $badkeys{$i} = "bad";   # just make them defined
  134. };
  135.  
  136.  
  137.  
  138. #
  139. # To do searches right, we have to make everything
  140. # for a field on one line.
  141. #    This routine does that, and also gets rid of {}'s
  142. # which tend to get in the way for searches.  In the
  143. # same vein, it collapses all whitespace to single spaces.
  144. #
  145. # To know when to join lines, we use two simple heuristics:
  146. # is there are a odd number of "'s on a line, we must enter or exit
  147. # multi-line mode.  If there are more {'s than }'s, we must enter,
  148. # and if there are more }'s than {'s we must exit (anything on
  149. # the first line is ignored).
  150. #
  151.  
  152. sub printtosearch {
  153.     local ($print) = @_;
  154.     local ($search, $mode) = ("", 1);
  155.     local ($opencurley, $closecurley) = (0,0);
  156.  
  157.     @lines = split(/\n/, $print);
  158.     @lines[0] =~ s/{/ /;
  159.     foreach $ln (@lines) {
  160.         # remove and count curley brackets
  161.         $opencurley = ($ln =~ s/[{]//g);
  162.         $closecurley = ($ln =~ s/[}]//g);
  163.         if ($opencurley-$closecurley < 0) {
  164.             $mode = 1;
  165.         } elsif ($opencurley-$closecurley > 0) {
  166.             $mode = 0;
  167.         } else {
  168.             # remove umlauts so quote handling works,
  169.             # and then change modes if required.
  170.             $ln =~ s/\\"//g;
  171.             $mode = !$mode  if (($ln =~ tr/"/"/) % 2 == 1);
  172.         };
  173.         $search .= $ln;
  174.         $search .= "\n"  if ($mode);
  175.     };
  176.     $search =~ s/[ \t]+/ /g;
  177.     return $search;
  178. }
  179.  
  180.  
  181. #
  182. # looking for beginning of bib entry is state 1, in bib is state 2
  183. #
  184. $LOOKING = 1;  $INBIB = 2;
  185.  
  186. foreach $file (@files) {
  187.     open (INF, "<$file") || warn ("cannot open bibfile $file\n");
  188.     $state = $LOOKING;
  189.  
  190.     while (<INF>) {
  191. #        print "line ", $i++, " state=$state: " . "$_\n";
  192.                     # beware RCS munging $state:...$
  193.         if ($state == $LOOKING) {
  194.             if (/^[ \t]*@(\w+)/) {   # beginning of entry
  195.                 ($key = $1) =~ tr/A-Z/a-z/;
  196.                     # case insensitive keywords
  197.                 if (! defined($badkeys{$key})) {
  198.                     $state = $INBIB;
  199.                     $bibentry = $_;
  200.                 } elsif ($passthroughbad) {
  201.                     print "$_";    # a hack for @string
  202.                 };
  203.             };
  204.         } elsif ($state == $INBIB) {
  205.             $bibentry .= $_;
  206.             if (/^[ \t]*}/) {   # ending
  207.                 $searchentry = &printtosearch($bibentry);
  208.                 if ($searchentry =~ /$pattern/i) {
  209.                     print "$file:\n" if ($manyfiles);
  210.                     print "$bibentry\n";
  211.                 };
  212.                 $state = $LOOKING;
  213.             }
  214.         } else {
  215.             die ("state problem, $state\n");
  216.         };
  217.     };
  218. };
  219.  
  220.  
  221.